home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue35 / tetris / TETRIS.ZIP / TETRIS1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-04-04  |  19.0 KB  |  690 lines
  1. unit Tetris1;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, ComCtrls;
  8.  
  9. const
  10.   GlassWidth=10;
  11.   GlassHeight=23;
  12.  
  13. var
  14.   GlassWorkSheet:    array [1..GlassHeight,1..GlassWidth] of Byte;
  15.   OldGlassWorkSheet: array [1..GlassHeight,1..GlassWidth] of Byte;
  16.  
  17. type
  18.   TFigureWorksheet=array [1..4,1..4] of Byte;
  19.  
  20. const
  21.   Triada: TFigureWorksheet=
  22.     ((0,1,0,0),
  23.      (1,1,1,0),
  24.      (0,0,0,0),
  25.      (0,0,0,0));
  26.   LCorner: TFigureWorksheet=
  27.     ((1,1,1,0),
  28.      (1,0,0,0),
  29.      (0,0,0,0),
  30.      (0,0,0,0));
  31.   RCorner: TFigureWorksheet=
  32.     ((1,1,1,0),
  33.      (0,0,1,0),
  34.      (0,0,0,0),
  35.      (0,0,0,0));
  36.   LZigzag: TFigureWorksheet=
  37.     ((1,1,0,0),
  38.      (0,1,1,0),
  39.      (0,0,0,0),
  40.      (0,0,0,0));
  41.   RZigzag: TFigureWorksheet=
  42.     ((0,1,1,0),
  43.      (1,1,0,0),
  44.      (0,0,0,0),
  45.      (0,0,0,0));
  46.   Stick: TFigureWorksheet=
  47.     ((1,1,1,1),
  48.      (0,0,0,0),
  49.      (0,0,0,0),
  50.      (0,0,0,0));
  51.   Box: TFigureWorksheet=
  52.     ((1,1,0,0),
  53.      (1,1,0,0),
  54.      (0,0,0,0),
  55.      (0,0,0,0));
  56.  
  57. const
  58.   FigureWorkSheet: TFigureWorksheet=
  59.     ((0,0,0,0),
  60.      (0,0,0,0),
  61.      (0,0,0,0),
  62.      (0,0,0,0));
  63.  
  64. const
  65.   BarWidth= 14;
  66.   BarHeight=14;
  67.  
  68.   NextBarWidth= 9;
  69.   NextBarHeight=9;
  70.  
  71. const
  72.   TopOfs=    6;
  73.   LeftOfs=   5;
  74.   FieldWidth=4;
  75.  
  76. const
  77.   MaxFigureNumber=7;
  78.   MaxCornerNumber=4;
  79.   MaxFigureSize=  4;
  80.   MaxFigureColor= 7;
  81.  
  82. type
  83.   TMoveDirect=  (mdDown,mdLeft,mdRight);
  84.   TFigureCorner=(fc00,fc90,fc180,fc270);
  85.  
  86. type
  87.   TTetro1 = class(TForm)
  88.     Label1: TLabel;
  89.     Label2: TLabel;
  90.     Label3: TLabel;
  91.     Label4: TLabel;
  92.     Timer1: TTimer;
  93.     Bevel3: TBevel;
  94.     SpeedButton1: TSpeedButton;
  95.     SpeedButton2: TSpeedButton;
  96.     SpeedButton3: TSpeedButton;
  97.     SpeedButton4: TSpeedButton;
  98.     SpeedButton5: TSpeedButton;
  99.     SpeedButton6: TSpeedButton;
  100.     SpeedButton7: TSpeedButton;
  101.     SpeedButton8: TSpeedButton;
  102.     Bevel1: TBevel;
  103.     Bevel2: TBevel;
  104.     SpeedButton9: TSpeedButton;
  105.     Bevel4: TBevel;
  106.     procedure FormPaint(Sender: TObject);
  107.     procedure Timer1Timer(Sender: TObject);
  108.     procedure FormCreate(Sender: TObject);
  109.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  110.       Shift: TShiftState);
  111.     procedure SpeedButton8Click(Sender: TObject);
  112.     procedure SpeedButton5Click(Sender: TObject);
  113.     procedure SpeedButton6Click(Sender: TObject);
  114.     procedure SpeedButton7Click(Sender: TObject);
  115.     procedure SpeedButton2Click(Sender: TObject);
  116.     procedure SpeedButton1Click(Sender: TObject);
  117.     procedure SpeedButton3Click(Sender: TObject);
  118.     procedure SpeedButton4Click(Sender: TObject);
  119.     procedure SpeedButton9Click(Sender: TObject);
  120.   private
  121.   public
  122.     Level:        Byte;
  123.     Score:        Longint;
  124.     ReentTimer:   Boolean;
  125.     ReentKeys:    Boolean;
  126.  
  127.     FigureActive: Boolean;
  128.     FigureType:   Byte;
  129.     FigureX:      Byte;
  130.     FigureY:      Byte;
  131.     FigureCorner: TFigureCorner;
  132.     FigureMove:   TMoveDirect;
  133.  
  134.     FirstColor:   Byte;
  135.     SecondColor:  Byte;
  136.     FirstFigure:  Byte;
  137.     SecondFigure: Byte;
  138.  
  139.     NextTopOfs:   Integer;
  140.     NextLeftOfs:  Integer;
  141.  
  142.     RedrawSheet:  Boolean;
  143.  
  144.     function  FigureXSize: Byte;
  145.     function  FigureYSize: Byte;
  146.     procedure GenerateNewFigure;
  147.     procedure ClearFigureIntoGlass;
  148.     function  PutFigureIntoGlass(MoveDirect: TMoveDirect): Boolean;
  149.     procedure RotateFigure;
  150.     procedure ScanFillLines;
  151.     procedure SetFigureColor;
  152.   end;
  153.  
  154. var
  155.   Tetro1: TTetro1;
  156.  
  157. implementation
  158.  
  159. uses Tetris2;
  160.  
  161. {$R *.DFM}
  162.  
  163. procedure TTetro1.FormPaint(Sender: TObject);
  164. var
  165.   X1,Y1,X2,Y2: Integer;
  166.   NewRect:     TRect;
  167.   I,J:         Byte;
  168.   CurSheet:    TFigureWorksheet;
  169.   NextColor:   TColor;
  170. begin
  171.   if RedrawSheet then FillChar(OldGlassWorkSheet,SizeOf(OldGlassWorkSheet),#255);
  172.   for I := 1 to GlassHeight do
  173.     for J := 1 to GlassWidth do begin
  174.       if GlassWorkSheet[I,J]=OldGlassWorkSheet[I,J] then Continue;
  175.       X1 := LeftOfs+(J-1)*BarWidth;
  176.       X2 := X1+BarWidth;
  177.       Y1 := TopOfs+(I-1)*BarHeight;
  178.       Y2 := Y1+BarHeight;
  179.       case GlassWorkSheet[I,J] of
  180.         0: Canvas.Brush.Color := clNavy;
  181.         1: Canvas.Brush.Color := clSilver;
  182.         2: Canvas.Brush.Color := clRed;
  183.         3: Canvas.Brush.Color := clLime;
  184.         4: Canvas.Brush.Color := clBlue;
  185.         5: Canvas.Brush.Color := clFuchsia;
  186.         6: Canvas.Brush.Color := clAqua;
  187.         7: Canvas.Brush.Color := clYellow;
  188.         8: Canvas.Brush.Color := clWhite;
  189.       end;
  190.       if GlassWorkSheet[I,J]>0 then begin
  191.         NewRect := Rect(X1+1,Y1+1,X2-1,Y2-1);
  192.         Canvas.FillRect(NewRect);
  193.         Canvas.Pen.Color := clGray;
  194.         Canvas.MoveTo(X1,Y1);
  195.         Canvas.LineTo(X1,Y2-1);
  196.         Canvas.LineTo(X2-1,Y2-1);
  197.         Canvas.Pen.Color := clWhite;
  198.         Canvas.LineTo(X2-1,Y1);
  199.         Canvas.LineTo(X1,Y1);
  200.       end
  201.       else begin
  202.         NewRect := Rect(X1,Y1,X2,Y2);
  203.         Canvas.FillRect(NewRect);
  204.       end;
  205.     end;
  206.   case FirstFigure of
  207.     0: Move(Triada,CurSheet,SizeOf(CurSheet));
  208.     1: Move(LCorner,CurSheet,SizeOf(CurSheet));
  209.     2: Move(RCorner,CurSheet,SizeOf(CurSheet));
  210.     3: Move(LZigzag,CurSheet,SizeOf(CurSheet));
  211.     4: Move(RZigzag,CurSheet,SizeOf(CurSheet));
  212.     5: Move(Stick,CurSheet,SizeOf(CurSheet));
  213.     6: Move(Box,CurSheet,SizeOf(CurSheet));
  214.   end;
  215.   case FirstColor of
  216.     0: NextColor := clNavy;
  217.     1: NextColor := clSilver;
  218.     2: NextColor := clRed;
  219.     3: NextColor := clLime;
  220.     4: NextColor := clBlue;
  221.     5: NextColor := clFuchsia;
  222.     6: NextColor := clAqua;
  223.     7: NextColor := clYellow;
  224.     8: NextColor := clWhite;
  225.   end;
  226.   for I := 1 to MaxFigureSize-2 do
  227.     for J := 1 to MaxFigureSize do begin
  228.       X1 := NextLeftOfs+(J-1)*NextBarWidth;
  229.       X2 := X1+NextBarWidth;
  230.       Y1 := NextTopOfs+(I-1)*NextBarHeight;
  231.       Y2 := Y1+NextBarHeight;
  232.       if CurSheet[I,J]>0 then begin
  233.         NewRect := Rect(X1+1,Y1+1,X2-1,Y2-1);
  234.         Canvas.Brush.Color := NextColor;
  235.         Canvas.FillRect(NewRect);
  236.         Canvas.Pen.Color := clGray;
  237.         Canvas.MoveTo(X1,Y1);
  238.         Canvas.LineTo(X1,Y2-1);
  239.         Canvas.LineTo(X2-1,Y2-1);
  240.         Canvas.Pen.Color := clWhite;
  241.         Canvas.LineTo(X2-1,Y1);
  242.         Canvas.LineTo(X1,Y1);
  243.       end
  244.       else begin
  245.         Canvas.Brush.Color := clSilver;
  246.         NewRect := Rect(X1,Y1,X2,Y2);
  247.         Canvas.FillRect(NewRect);
  248.       end;
  249.     end;
  250.   Move(GlassWorkSheet,OldGlassWorkSheet,SizeOf(OldGlassWorkSheet));
  251. end;
  252.  
  253. function TTetro1.FigureXSize: Byte;
  254. var
  255.   I,J,K: Byte;
  256. begin
  257.   K := 0;
  258.   for J := 1 to MaxFigureSize do
  259.     for I := 1 to MaxFigureSize do
  260.       if FigureWorkSheet[J,I]>0 then
  261.         if K<I then K := I;
  262.   FigureXSize := K;
  263. end;
  264.  
  265. function TTetro1.FigureYSize: Byte;
  266. var
  267.   I,J,K: Byte;
  268. begin
  269.   K := 0;
  270.   for J := 1 to MaxFigureSize do
  271.     for I := 1 to MaxFigureSize do
  272.       if FigureWorkSheet[J,I]>0 then
  273.         if K<J then K := J;
  274.   FigureYSize := K;
  275. end;
  276.  
  277. procedure TTetro1.GenerateNewFigure;
  278. begin
  279.   Timer1.Enabled := False;
  280.   SecondFigure := FirstFigure;
  281.   SecondColor := FirstColor;
  282.   FigureType := SecondFigure;
  283.   FigureX := 5;
  284.   FigureY := 0;
  285.   FigureCorner := fc270;
  286.   FillChar(FigureWorkSheet,SizeOf(FigureWorkSheet),0);
  287.   case FigureType of
  288.     0: Move(Triada,FigureWorkSheet,SizeOf(FigureWorkSheet));
  289.     1: Move(LCorner,FigureWorkSheet,SizeOf(FigureWorkSheet));
  290.     2: Move(RCorner,FigureWorkSheet,SizeOf(FigureWorkSheet));
  291.     3: Move(LZigzag,FigureWorkSheet,SizeOf(FigureWorkSheet));
  292.     4: Move(RZigzag,FigureWorkSheet,SizeOf(FigureWorkSheet));
  293.     5: Move(Stick,FigureWorkSheet,SizeOf(FigureWorkSheet));
  294.     6: Move(Box,FigureWorkSheet,SizeOf(FigureWorkSheet));
  295.   end;
  296.   SetFigureColor;
  297.   FigureMove := mdDown;
  298.   FirstFigure := Random(MaxFigureNumber);
  299.   FirstColor := Random(MaxFigureColor)+1;
  300.   Timer1.Enabled := True;
  301. end;
  302.  
  303. procedure TTetro1.ClearFigureIntoGlass;
  304. var
  305.   I,J: Byte;
  306. begin
  307.   for J := 1 to FigureYSize do
  308.     for I := 1 to FigureXSize do
  309.       if FigureWorkSheet[J,I]>0 then
  310.         GlassWorkSheet[FigureY+J,FigureX+I] := 0;
  311. end;
  312.  
  313. function TTetro1.PutFigureIntoGlass(MoveDirect: TMoveDirect): Boolean;
  314. var
  315.   I,J: Byte;
  316. begin
  317.   PutFigureIntoGlass := True;
  318.   if (FigureY+FigureYSize>GlassHeight) and (MoveDirect=mdDown) then begin
  319.     Dec(FigureY);
  320.     PutFigureIntoGlass := False;
  321.     Exit;
  322.   end
  323.   else
  324.     while (FigureX+FigureXSize>GlassWidth) and (MoveDirect=mdDown) do
  325.        Dec(FigureX);
  326.     for J := 1 to FigureYSize do begin
  327.       for I := 1 to FigureXSize do begin
  328.         if (FigureWorkSheet[J,I]>0) and
  329.           (GlassWorkSheet[FigureY+J,FigureX+I]>0) then begin
  330.           PutFigureIntoGlass := False;
  331.           case MoveDirect of
  332.             mdDown:  Dec(FigureY);
  333.             mdRight: Dec(FigureX);
  334.             mdLeft:  Inc(FigureX);
  335.           end;
  336.           Exit;
  337.         end;
  338.       end;
  339.     end;
  340.   for J := 1 to FigureYSize do
  341.     for I := 1 to FigureXSize do
  342.       if FigureWorkSheet[J,I]>0 then
  343.         GlassWorkSheet[FigureY+J,FigureX+I] := FigureWorkSheet[J,I];
  344.   RedrawSheet := False;
  345.   FormPaint(Self);
  346.   RedrawSheet := True;
  347. end;
  348.  
  349. procedure TTetro1.ScanFillLines;
  350. var
  351.   I,J,K,L: byte;
  352. begin
  353.   ClearFigureIntoGlass;
  354.   for I := 1 to GlassHeight do begin
  355.     K := 0;
  356.     for J := 1 to GlassWidth do
  357.       if GlassWorkSheet[I,J]>0 then Inc(K);
  358.     if K=GlassWidth then begin
  359.       for L := I downto 1 do
  360.         for J := 1 to GlassWidth do
  361.           if L>1 then GlassWorkSheet[L,J] := GlassWorkSheet[L-1,J];
  362.     end;
  363.   end;
  364.   PutFigureIntoGlass(FigureMove);
  365. end;
  366.  
  367. procedure TTetro1.Timer1Timer(Sender: TObject);
  368. var
  369.   I,J: Byte;
  370. begin
  371.   if ReentTimer then Exit
  372.     else ReentTimer := True;
  373.   if StrToInt(Label3.Caption)<>Level then Label3.Caption := IntToStr(Level);
  374.   if StrToInt(Label4.Caption)<>Score then Label4.Caption := IntToStr(Score);
  375.   if not FigureActive then begin
  376.     GenerateNewFigure;
  377.     if not PutFigureIntoGlass(FigureMove) then begin
  378.       MessageDlg('Glass is full... Game over!',mtInformation,[mbOk],0);
  379.       FillChar(OldGlassWorkSheet,SizeOf(OldGlassWorkSheet),#255);
  380.       Timer1.Enabled := False;
  381.       SpeedButton1.Enabled := False;
  382.       SpeedButton2.Enabled := False;
  383.       SpeedButton3.Enabled := False;
  384.       SpeedButton4.Enabled := False;
  385.       SpeedButton5.Enabled := True;
  386.       SpeedButton6.Enabled := False;
  387.       SpeedButton7.Enabled := False;
  388.       ClearFigureIntoGlass;
  389.       FigureActive := False;
  390.       Level := 1;
  391.       Score := 0;
  392.       for I := 1 to GlassHeight do
  393.         for J := 1 to GlassWidth do GlassWorkSheet[I,J] := 0;
  394.       RedrawSheet := False;
  395.       FormPaint(Self);
  396.       RedrawSheet := True;
  397.     end;
  398.     FigureActive := True;
  399.   end
  400.   else begin
  401.     ClearFigureIntoGlass;
  402.     Inc(FigureY);
  403.     if not PutFigureIntoGlass(FigureMove) then begin
  404.       case FigureType of
  405.         0: Score := Score+10;
  406.         1: Score := Score+30;
  407.         2: Score := Score+30;
  408.         3: Score := Score+25;
  409.         4: Score := Score+25;
  410.         5: Score := Score+15;
  411.         6: Score := Score+20;
  412.       end;
  413.       if Score>300 then Level := 2;
  414.       if Score>700 then Level := 3;
  415.       if Score>1300 then Level := 4;
  416.       if Score>2000 then Level := 5;
  417.       if Score>3000 then Level := 6;
  418.       if Score>5000 then Level := 7;
  419.       Timer1.Interval := Round((7.1-Level)*100);
  420.       FigureActive := False;
  421.     end;
  422.   end;
  423.   ScanFillLines;
  424.   ReentTimer := False;
  425. end;
  426.  
  427. procedure TTetro1.FormCreate(Sender: TObject);
  428. begin
  429.   FillChar(OldGlassWorkSheet,SizeOf(OldGlassWorkSheet),#255);
  430.   RedrawSheet := True;
  431.   with Bevel3 do begin
  432.     Top := TopOfs-FieldWidth;
  433.     Left := LeftOfs-FieldWidth;
  434.     Width := GlassWidth*BarWidth+FieldWidth*2;
  435.     Height := GlassHeight*BarHeight+FieldWidth*2;
  436.   end;
  437.   ClientWidth := Bevel3.Width+FieldWidth*3+SpeedButton5.Width;
  438.   ClientHeight := Bevel3.Height+FieldWidth*2;
  439.   SpeedButton1.Left := Bevel3.Width+FieldWidth*2-2;
  440.   SpeedButton2.Left := SpeedButton1.Left+SpeedButton1.Width+1;
  441.   SpeedButton3.Left := SpeedButton2.Left+SpeedButton2.Width+1;
  442.   SpeedButton4.Left := SpeedButton2.Left;
  443.   SpeedButton5.Left := Bevel3.Width+FieldWidth*2;
  444.   SpeedButton6.Left := SpeedButton5.Left;
  445.   SpeedButton7.Left := SpeedButton5.Left;
  446.   SpeedButton8.Left := SpeedButton5.Left;
  447.   SpeedButton9.Left := SpeedButton5.Left;
  448.   Label1.Left := Bevel3.Width+FieldWidth*2;
  449.   Label2.Left := Label1.Left;
  450.   Bevel1.Left := Label1.Left;
  451.   Bevel1.Width := SpeedButton5.Width;
  452.   Bevel2.Left := Label1.Left;
  453.   Bevel2.Width := SpeedButton5.Width;
  454.   Label3.Left := Bevel1.Left+FieldWidth;
  455.   Label4.Left := Bevel1.Left+FieldWidth;
  456.   Bevel4.Top := SpeedButton9.Top+SpeedButton9.Height+4;
  457.   Bevel4.Left := SpeedButton9.Left+SpeedButton9.Width div 4-4;
  458.   Bevel4.Height := NextBarHeight*(MaxFigureSize-1)+4;
  459.   Bevel4.Width :=NextBarWidth*MaxFigureSize+8;
  460.   NextTopOfs := SpeedButton9.Top+SpeedButton9.Height+8;
  461.   NextLeftOfs := SpeedButton9.Left+SpeedButton9.Width div 4;
  462.   Level := 1;
  463.   Timer1.Interval := Round((6.5-Level)*100);
  464.   Score := 0;
  465.   ReentTimer := False;
  466.   ReentKeys := False;
  467.   FigureActive := False;
  468.   Label3.Caption := '1';
  469.   Label4.Caption := '0';
  470.   Randomize;
  471.   FirstFigure := Random(MaxFigureNumber);
  472.   FirstColor := Random(MaxFigureColor)+1;
  473. end;
  474.  
  475. procedure TTetro1.RotateFigure;
  476. var
  477.   OldFigureCornet: TFigureCorner;
  478.   CurSheet:        TFigureWorksheet;
  479.   OldFigureCorner: TFigureCorner;
  480. procedure RotateFigureWorksheet;
  481. var
  482.   VertFlag:  Byte;
  483.   HorizFlag: Byte;
  484.   K,I,J:     Byte;
  485. begin
  486.   FillChar(FigureWorkSheet,SizeOf(FigureWorkSheet),0);
  487.   case FigureType of
  488.     0: Move(Triada,FigureWorkSheet,SizeOf(FigureWorkSheet));
  489.     1: Move(LCorner,FigureWorkSheet,SizeOf(FigureWorkSheet));
  490.     2: Move(RCorner,FigureWorkSheet,SizeOf(FigureWorkSheet));
  491.     3: Move(LZigzag,FigureWorkSheet,SizeOf(FigureWorkSheet));
  492.     4: Move(RZigzag,FigureWorkSheet,SizeOf(FigureWorkSheet));
  493.     5: Move(Stick,FigureWorkSheet,SizeOf(FigureWorkSheet));
  494.     6: Move(Box,FigureWorkSheet,SizeOf(FigureWorkSheet));
  495.   end;
  496.   FillChar(CurSheet,SizeOf(CurSheet),0);
  497.   for K := 0 to Byte(FigureCorner) do begin
  498.     for I := 1 to MaxFigureSize do
  499.       for J := 1 to MaxFigureSize do
  500.         CurSheet[J,I] := FigureWorkSheet[MaxFigureSize-I+1,J];
  501.     Move(CurSheet,FigureWorkSheet,SizeOf(FigureWorkSheet));
  502.   end;
  503.   SetFigureColor;
  504.   HorizFlag := 0;
  505.   while HorizFlag=0 do begin
  506.     for I := 1 to MaxFigureSize do
  507.       if FigureWorkSheet[1,I]>0 then HorizFlag := 1;
  508.     if HorizFlag=0 then begin
  509.       for J := 1 to MaxFigureSize-1 do
  510.         for I := 1 to MaxFigureSize do
  511.           FigureWorkSheet[J,I] := FigureWorkSheet[J+1,I];
  512.       for J := 1 to MaxFigureSize do
  513.         FigureWorkSheet[MaxFigureSize,J] := 0;
  514.     end;
  515.   end;
  516.   VertFlag := 0;
  517.   while VertFlag=0 do begin
  518.     for J := 1 to MaxFigureSize do
  519.       if FigureWorkSheet[J,1]>0 then VertFlag := 1;
  520.     if VertFlag=0 then begin
  521.       for J := 1 to MaxFigureSize do
  522.         for I := 1 to MaxFigureSize-1 do
  523.           FigureWorkSheet[J,I] := FigureWorkSheet[J,I+1];
  524.       for J := 1 to MaxFigureSize do
  525.         FigureWorkSheet[J,MaxFigureSize] := 0;
  526.     end;
  527.   end;
  528. end;
  529. begin
  530.   ClearFigureIntoGlass;
  531.   OldFigureCorner := FigureCorner;
  532.   if FigureCorner>fc00 then Dec(FigureCorner)
  533.     else FigureCorner := fc270;
  534.   RotateFigureWorksheet;
  535.   if not PutFigureIntoGlass(mdDown) then begin
  536.     FigureCorner := OldFigureCorner;
  537.     RotateFigureWorksheet;
  538.     PutFigureIntoGlass(mdDown);
  539.   end;
  540. end;
  541.  
  542. procedure TTetro1.FormKeyDown(Sender: TObject; var Key: Word;
  543.   Shift: TShiftState);
  544. begin
  545.   if ReentKeys then Exit
  546.     else ReentKeys := True;
  547.   if not FigureActive then begin
  548.     ReentKeys := False;
  549.     Exit;
  550.   end;
  551.   case Key of
  552.     VK_UP:    RotateFigure;
  553.     VK_DOWN,
  554.     VK_SPACE: begin
  555.                 repeat
  556.                   ClearFigureIntoGlass;
  557.                   Inc(FigureY);
  558.                 until not PutFigureIntoGlass(mdDown);
  559.                 Inc(Score,5);
  560.               end;
  561.     VK_LEFT:  if FigureX>0 then begin
  562.                 ClearFigureIntoGlass;
  563.                 Dec(FigureX);
  564.                 PutFigureIntoGlass(mdLeft);
  565.               end;
  566.     VK_RIGHT: if FigureX+FigureXSize<GlassWidth then begin
  567.                 ClearFigureIntoGlass;
  568.                 Inc(FigureX);
  569.                 PutFigureIntoGlass(mdRight);
  570.               end;
  571.   end;
  572.   ReentKeys := False;
  573. end;
  574.  
  575. procedure TTetro1.SetFigureColor;
  576. var
  577.   I,J: Byte;
  578. begin
  579.   for I := 1 to MaxFigureSize do
  580.     for J := 1 to MaxFigureSize do
  581.       if FigureWorkSheet[I,J]>0 then FigureWorkSheet[I,J] := SecondColor;
  582. end;
  583.  
  584. procedure TTetro1.SpeedButton8Click(Sender: TObject);
  585. begin
  586.   if MessageDlg('Exit programm?',mtConfirmation,[mbYes,mbNo],0)=mrYes then
  587.     Application.Terminate;
  588. end;
  589.  
  590. procedure TTetro1.SpeedButton5Click(Sender: TObject);
  591. begin
  592.   Timer1.Enabled := True;
  593.   SpeedButton5.Enabled := False;
  594.   SpeedButton1.Enabled := True;
  595.   SpeedButton2.Enabled := True;
  596.   SpeedButton3.Enabled := True;
  597.   SpeedButton4.Enabled := True;
  598.   SpeedButton6.Enabled := True;
  599.   SpeedButton7.Enabled := True;
  600. end;
  601.  
  602. procedure TTetro1.SpeedButton6Click(Sender: TObject);
  603. begin
  604.   if Timer1.Enabled then begin
  605.     Timer1.Enabled := False;
  606.     SpeedButton1.Enabled := False;
  607.     SpeedButton2.Enabled := False;
  608.     SpeedButton3.Enabled := False;
  609.     SpeedButton4.Enabled := False;
  610.     SpeedButton7.Enabled := False;
  611.   end
  612.   else begin
  613.     Timer1.Enabled := True;
  614.     SpeedButton1.Enabled := True;
  615.     SpeedButton2.Enabled := True;
  616.     SpeedButton3.Enabled := True;
  617.     SpeedButton4.Enabled := True;
  618.     SpeedButton7.Enabled := True;
  619.   end;
  620. end;
  621.  
  622. procedure TTetro1.SpeedButton7Click(Sender: TObject);
  623. var
  624.   I,J: Byte;
  625. begin
  626.   Timer1.Enabled := False;
  627.   ClearFigureIntoGlass;
  628.   FigureActive := False;
  629.   Level := 1;
  630.   Score := 0;
  631.   for I := 1 to GlassHeight do
  632.     for J := 1 to GlassWidth do GlassWorkSheet[I,J] := 0;
  633.   RedrawSheet := False;
  634.   FormPaint(Self);
  635.   RedrawSheet := True;
  636.   Timer1.Enabled := True;
  637. end;
  638.  
  639. procedure TTetro1.SpeedButton2Click(Sender: TObject);
  640. begin
  641.   Timer1.Enabled := False;
  642.   RotateFigure;
  643.   Timer1.Enabled := True;
  644. end;
  645.  
  646. procedure TTetro1.SpeedButton1Click(Sender: TObject);
  647. begin
  648.   Timer1.Enabled := False;
  649.   if FigureX>0 then begin
  650.     ClearFigureIntoGlass;
  651.     Dec(FigureX);
  652.     PutFigureIntoGlass(mdLeft);
  653.   end;
  654.   Timer1.Enabled := True;
  655. end;
  656.  
  657. procedure TTetro1.SpeedButton3Click(Sender: TObject);
  658. begin
  659.   Timer1.Enabled := False;
  660.   if FigureX+FigureXSize<GlassWidth then begin
  661.     ClearFigureIntoGlass;
  662.     Inc(FigureX);
  663.     PutFigureIntoGlass(mdRight);
  664.   end;
  665.   Timer1.Enabled := True;
  666. end;
  667.  
  668. procedure TTetro1.SpeedButton4Click(Sender: TObject);
  669. begin
  670.   Timer1.Enabled := False;
  671.   repeat
  672.     ClearFigureIntoGlass;
  673.     Inc(FigureY);
  674.   until not PutFigureIntoGlass(mdDown);
  675.   Inc(Score,5);
  676.   Timer1.Enabled := True;
  677. end;
  678.  
  679. procedure TTetro1.SpeedButton9Click(Sender: TObject);
  680. var
  681.   OldState: Boolean;
  682. begin
  683.   OldState := Timer1.Enabled;
  684.   Timer1.Enabled := False;
  685.   Tetro2.ShowModal;
  686.   Timer1.Enabled := OldState;
  687. end;
  688.  
  689. end.
  690.